home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
gametp20.zip
/
MOUSE.INT
< prev
next >
Wrap
Text File
|
1992-11-05
|
6KB
|
179 lines
Unit Mouse;
{ MOUSE version 1.0 Copyright (C) 1992 Scott D. Ramsay }
{ ramsays@access.digex.com }
{ MOUSE.TPU can be used freely in commerical and non-commerical }
{ programs. As long as you don't give yourself credit for writing }
{ this portion of the code. When distributing it please include all }
{ files and samples so others may enjoy using the code. Thanks. }
Interface
Uses Dos;
const
visible : boolean = false; { TRUE if mouse cursor is visible }
mousehere : boolean = false; { TRUE if the mouse drv is here }
mousewason : boolean = false; { TRUE is mouse was on from last MOUSEOFF call }
mouseoncall : boolean = false; { TRUE if last call was MOUSEON, MOUSEOFF }
skl : integer = 1; { Scale value for X, some mouse drivers }
{ widths resolutions for mode 13h is }
{ 0..639 instead of 0..319. Set during }
{ mousereset. To use: }
{ getmouse(button,x,y); x := x shr skl; }
var
m1,m2,m3,m4 : integer; { work variables. Can use with functions }
procedure mset(var m1,m2,m3,m4:integer);
function mousereset:integer;
procedure mouseon;
procedure mouseoff;
procedure getmouse(var m2,m3,m4:integer);
procedure setmouse(m3,m4:integer);
procedure getmousepresses(var m2,m3,m4:integer);
procedure getmousereleases(var m2,m3,m4:integer);
procedure getmousemotion(var m3,m4:integer);
procedure setmousecursor(m2,m3:integer; var mask);
procedure setmouseratio(m3,m4:integer);
procedure setmouseoff(x1,y1,x2,y2:integer);
procedure cleanmouse;
procedure chkmouseon;
procedure setdefptr;
procedure normalizemx;
{ See Implementation section for description of functions }
implementation
(*************************************************************************)
procedure setdefptr;
Set mouse cursor to a small arrow pointer
(*************************************************************************)
procedure mset(var m1,m2,m3,m4:integer);
Send a mouse command to interrupt 33 hex.
m1 maps to AX register
m2 maps to BX
m3 maps to CX
m4 maps to DX
on return m1..m4 contains returns values of AX..DX
(*************************************************************************)
procedure setmousecursor(m2,m3:integer; var mask);
Sets the mouse cursor to new shape. Largest size is 16x16
m2,m3 (x,y) hot spot of mouse cursor.
mask new mouse shape. Mask is:
MyMouseCursor : array[0..31] of word;
index 0..15, defines transparent mask
index 16..31, defines shape.
Each word is a row in shape. It bit is a pixel in
shape.
Small_Arrow : array[0..31] of word =
($1fff,$0fff,$07ff,$03ff,$07ff,$03ff,$e7ff,$ffff,
$ffff,$ffff,$ffff,$ffff,$ffff,$ffff,$ffff,$ffff,
$0000,$4000,$6000,$7000,$6000,$1000,$0000,$0000,
$0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000);
(*************************************************************************)
function mousereset:integer;
Checks to see if the mouse/mouse driver is installed.
returns 0 if error.
Calls normalizemx
(*************************************************************************)
procedure mouseon;
Turns on the mouse cursor
(*************************************************************************)
procedure chkmouseon;
If mouseoff was called, and the mouse cursor was off then
this procedure turn on the mouse cursor
(*************************************************************************)
procedure mouseoff;
Turns off the mouse (hides it)
(*************************************************************************)
procedure getmouse(var m2,m3,m4:integer);
Gets the current status of the mouse.
m2 Bit for each mouse button pressed.
button1press := boolean(m2 and 1);
button2press := boolean(m2 and 2);
button3press := boolean(m2 and 4);
(*************************************************************************)
procedure setmouse(m3,m4:integer);
Sets the mouse position.
m3,m4 New (x,y) coordinates. check SKL variable if X value
needs to be scaled. X := X shl skl;
(*************************************************************************)
procedure getmousepresses(var m2,m3,m4:integer);
m2 Button flag
m3,m4 Press area (x,y)
(*************************************************************************)
procedure getmousereleases;
m2 Button flag
m3,m4 Release area (x,y)
(*************************************************************************)
procedure getmousemotion(var m3,m4:integer);
Returns the velocity of the mouse.
m3,m4 (dx,dy) of mouse. Returns values of (0,0) means the mouse is not
moving.
(*************************************************************************)
procedure cleanmouse;
Waits until all mouse buttons are released
(*************************************************************************)
procedure setmouseratio(m3,m4:integer);
Sets the speed of the mouse motion.
m3,m4 (x,y) speed.
(*************************************************************************)
procedure setmouseoff(x1,y1,x2,y2:integer);
Sets a rectangular area that if the mouse is on it will not
be displayed in that area. To turn this rectangle area off call
MOUSERESET.
(*************************************************************************)
procedure normalizemx;
MOUSERESET calls the procedure. Sets the value of SKL based on
the inital position of the mouse when initalized.
see SKL constant.